MacFormat 1999 Spring/macformat-077.iso/Shareware Plus/Development/Akua Sweets 131/Akua Sweets Examples/Internet/opo.akua.ch Update

Text File | 1999-03-04 | 5.4 KB | 266 lines | [TEXT/ToyS]

property kasRemoteURL : "ftp://opo:[e-mail]"
-- property kasRemoteURL : "ftp://opo:opo@11.9.0.20"
property kasRemotePath : "/"
property kasLocalPath : ":OPO:"


property kasPrefName : (kasRemoteURL & " >> " & kasRemotePath)

global gasToSync, gasLastUpdate
global gasInfo, gasInfoPos
global gasUpFile, gasUpFold, gasRmFile, gasRmFold


on run
    set thisDate to current date
    pfLoad()

    set gasUpFile to 0
    set gasUpFold to 0
    set gasRmFile to 0
    set gasRmFold to 0

    set gasInfo to display info titled ((kasLocalPath as string) & " => " & kasRemotePath) ¬
        message ("Host: " & kasRemoteURL) ¬
        located at gasInfoPos

    set gasToSync to {{kasRemotePath, kasLocalPath}}

    ShowAction("Connecting")
    tell application "Fetch" to activate
    pause for 60
    tell application "Fetch"
        geturl kasRemoteURL
        set tw to transfer window 1
    end tell
    pause for 60
    activate

    repeat while gasToSync is not {}
        display info gasInfo ¬
            message ("Folders to go: " & (the number of items in gasToSync)) ¬
            at line 10
        -- Fifo list
        set iSync to item 1 of gasToSync
        if (number of items of gasToSync) is 1 then
            set gasToSync to {}
        else
            set gasToSync to items 2 thru -1 of gasToSync
        end if

        set lPath to (item 2 of iSync) as string
        set rPath to item 1 of iSync

        ShowRemote(rPath)
        ShowLocal(lPath)

        set tw to UpNewer(tw, lPath, rPath, gasLastUpdate)
    end repeat

    tell application "Fetch"
        activate
        ignoring application responses
            close tw
        end ignoring
    end tell

    activate

    set gasInfoPos to screen location of ¬
        (display info gasInfo with disposal)

    set gasLastUpdate to thisDate
    pfSave()
end run


on UpNewer(tw, lPath, rPath, lastUpdate)
    ShowAction("Checking for updated files…")
    set lList to LocalListNewer(lPath, lastUpdate)

    -- Scan for local files in remote list
    ShowAction("Uploading updated files…")
    set uploadedOne to false
    set lFiles to item 1 of lList

    repeat with lName in lFiles
        ShowFile(lName)

        -- Upload missing file?
        if (not uploadedOne) then
            set tw to FetchDirSet(tw, rPath)
            set uploadedOne to true
        end if

        ShowAction("Uploading")
        FetchUL(tw, (lPath & lName) as alias, rPath)
        ShowFileCnt()
    end repeat

    -- Check directories, queue local to sync
    ShowAction("Queuing Folders…")

    set lDirs to item 2 of lList
    repeat with ld in lDirs
        -- Check for remote existance
        ShowFile(ld)
        set gasToSync to gasToSync & {{rPath & ld & "/", (lPath & ld) as alias}}
    end repeat

    return tw
end UpNewer


on FetchUL(tw, lAlias, rPath)
    try
        with timeout of 60 seconds
            tell application "Fetch" to ¬
                put into tw item lAlias ¬
                    text format text binary format Raw Data
        end timeout
    on error
        set tw to FetchDirSet(tw, rPath)
        with timeout of 60 seconds
            try
                tell application "Fetch" to ¬
                    put into tw item lAlias ¬
                        text format text binary format Raw Data
            on error
                return FetchUL(tw, lAlias, rPath)
            end try
        end timeout
    end try

    return tw
end FetchUL


on LocalListNewer(pathAlias, newerThan)
    ShowAction("Local Listing")

    set fList to the entries in pathAlias ¬
        whose kinds are a file ¬
        who were modified after newerThan

    set pList to the entries in pathAlias ¬
        whose kinds are a folder

    return {fList, pList}
end LocalListNewer


on FetchDirSet(tw, vpath)
    ShowAction("Remote CD")

    try
        with timeout of 60 seconds
            tell application "Fetch" to ¬
                set current directory of tw to vpath
        end timeout
        pause for 30
    on error err
        ShowAction("Reconnect…")
        with timeout of 300 seconds
            tell application "Fetch"
                activate
                close tw
            end tell
        end timeout
        pause for 30
        try
            with timeout of 60 seconds
                tell application "Fetch"
                    activate
                    geturl kasRemoteURL
                    set tw to transfer window 1
                end tell
            end timeout
            pause for 30
            with timeout of 60 seconds
                tell application "Fetch"
                    activate
                    set current directory of tw to vpath
                end tell
            end timeout
            activate
        on error err
            activate
            -- display dialog ("Connection Lost?" & return & return & "(" & err & ")") ¬
            -- buttons {"Cancel", "OK"} default button 2 with icon stop
            set tw to FetchDirSet(tw, vpath)
        end try
    end try

    return tw
end FetchDirSet


on ShowAction(msg)
    display info gasInfo ¬
        message msg ¬
        at line 15 ¬
        using color 15
end ShowAction


on ShowRemote(msg)
    display info gasInfo ¬
        message msg ¬
        at line 5 ¬
        using color 10 * 32
end ShowRemote


on ShowLocal(msg)
    display info gasInfo ¬
        message msg ¬
        at line 4 ¬
        using color 10 * 32
end ShowLocal


on ShowFile(msg)
    display info gasInfo ¬
        message msg ¬
        at line 6 ¬
        using color (10 * 32 + 10) ¬
        with a change of style
end ShowFile


on ShowFileCnt()
    set gasUpFile to gasUpFile + 1
    display info gasInfo ¬
        message ("Uploaded " & gasUpFile & " file(s)") ¬
        at line 13 ¬
        using color (10 * 1024 + 10 * 32)
end ShowFileCnt


on ShowFoldCnt()
    set gasUpFold to gasUpFold + 1
    display info gasInfo ¬
        message ("Uploaded " & gasUpFold & " folder(s)") ¬
        at line 14 ¬
        using color (10 * 1024 + 10 * 32)
end ShowFoldCnt


on pfLoad()
    try
        set ourPrefs to (load preference named kasPrefName)
        set gasInfoPos to item 1 of ourPrefs
        set gasLastUpdate to item 2 of ourPrefs
    on error
        set gasInfoPos to {-1, -1}
        set gasLastUpdate to current date
        pfSave()
        display dialog "First run, time marked!" buttons {"Cancel"} default button 1
    end try
end pfLoad


on pfSave()
    save preference {gasInfoPos, gasLastUpdate} named kasPrefName
end pfSave